home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / tcqbsnip.zip / SBSOUND.BAS < prev    next >
BASIC Source File  |  1997-06-20  |  3KB  |  98 lines
  1. ' SBSOUND.BAS
  2. ' by Tika Carr
  3. '
  4. ' Donated to the public domain
  5. ' No warranties or guarantees are expressed or implied.
  6. '
  7. ' Purpose: Demonstrates how to make a sound using Sound Blaster
  8. '
  9. ' Start QuickBasic with: QB /L QB.QLB
  10. '
  11. '
  12. ' Credits: Wouter Bergmann Tiest - QBasic SoundBlaster Documentation
  13. '          Nancy Backus          - Note/Frequency & Tuning Information
  14.  
  15. DECLARE SUB WriteReg (r%, v%)
  16. DEFINT A-Z
  17.  
  18. CONST BaseAddr = &H220
  19. CONST DataReg = BaseAddr + 9, RegAddr = BaseAddr + 8
  20.  
  21. CLS
  22.  
  23. I = 1
  24. DO UNTIL INSTR(ENVIRON$(I), "BLASTER") OR ENVIRON$(I) = "": I = I + 1: LOOP
  25.  
  26. 'BaseReg = VAL(RIGHT$(MID$(ENVIRON$(i), INSTR(ENVIRON$(i), "=A"), 5), 3))
  27. 'IF BaseReg = 0 THEN PRINT "No Sound Card Found or Environment Variable not set.": END
  28.  
  29. '*** clear all registers
  30. FOR I = 0 TO 224: WriteReg I, 0: NEXT
  31.  
  32. '*** start channel
  33.  
  34. 'Change &H1 in the next line to change the instrument sound.
  35. WriteReg &H20, &H1    'Plays carrier note at spcified octave ch. 1
  36.  
  37. 'Change &H1 in the next line to change the instrument timbre or tonal sound.
  38. WriteReg &H23, &H1    'Plays modulator note at specified octave ch. 1
  39.  
  40. 'Changing &H1F in the next line also seems to change the tonal sound
  41. WriteReg &H40, &H1F   'Set carrier total level to softest ch. 1
  42.  
  43. 'The next one I can't figure out. But Guess best to leave at &H1.
  44. WriteReg &H43, &H1    'Set modulator level to loudest ch. 1
  45.  
  46.  
  47. 'The next 2 lines lets you set how long to play the note, and its
  48. 'attack/decay rate. Original code had it set to &HE4. I found that the
  49. 'first 4 bits are what does it(ie, &HE0 - &HE9, etc.) &HE0 is the
  50. 'longest length and &HE9 is the shortest. I set this to make a steady tone.
  51.  
  52. 'This line gives or takes the "bass-like" sound.
  53. WriteReg &H60, &HE1 'Set carrier attack and decay ch. 1
  54.  
  55. 'The second line is how long to hold the note, I think...
  56. WriteReg &H63, &HE0 'Set modulator attack and decay ch. 1
  57.  
  58. 'The next two lines are same as above, I guess, but with respect to
  59. 'Sustain and release.
  60. WriteReg &H80, &H9D 'Set carrier sustain and release ch. 1
  61. WriteReg &H83, &H9D 'Set modulator sustain and release ch. 1
  62.  
  63. '**************** The Frequency of Notes *********************
  64. '
  65. '     C                middle C   D   E   F   G   A              C
  66. '     128 Hz           256 Hz                     440 Hz         512 Hz
  67. '                                                   SB-A
  68. '                                                   442/443 Hz
  69.  
  70. 'Middle C is at 256 Hz. The C octaves are in the powers of 2.
  71. 'Normal A is at 440 Hz to 445 Hz. The Sound Card's A note is somewhere
  72. 'between 442 and 443 Hz.
  73.  
  74. 'Play "A" note (at 442 - 443 Hz)
  75. '&HA0 (Decimal 160) is between 442 and 443 Hz.
  76. '&HA1 (Decimal 161) is one whole note below A (ie. a "G" note)
  77. 'but so is &H9F (decimal 159) a G note.
  78.  
  79. '&H41 (decimal 65) actually changes the PITCH (Frequency) of the note!
  80. 'Change &H41 to &H30 (decimal 48) and leave &HA0 the same. Notice the change!
  81.  
  82. WriteReg &HA0, &H41         'Set note number
  83.  
  84. 'Change the &H22 in the next line to make the octive go higher/lower
  85. WriteReg &HB0, &H22 + 4 * 2 'Set base + 4 * octave and turn on voice
  86.  
  87. time! = TIMER: duration! = 1
  88. DO: LOOP WHILE time! + duration! > TIMER    'wait as long as duration
  89.  
  90. WriteReg &HB0, 0    'Turn off voices
  91.  
  92. DEFSNG A-Z
  93. SUB WriteReg (r%, v%)
  94. OUT RegAddr, r%
  95. OUT DataReg, v%
  96. END SUB
  97.  
  98.